perm filename TEMP[S1,ALS] blob
sn#483569 filedate 1979-10-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Recent corrections to SOPU as of Oct. 17 1979
C00011 ENDMK
C⊗;
Recent corrections to SOPU as of Oct. 17 1979
OLDMAXTMPS1REG : S1REGISTER; (*pn*)
PSWITCHNAME,MOSTCOMPLEXPROC,CHKNAME: alfa; (*pn*)
BOUND : integer; (* pn *)
WRITELN(OUTPUT,'Not yet implemented') (*pn*)
procedure PRINTSCONST(var STRVAL : STRINGTYPE; var STRLGTH : STRINX);
(*Print a string from STRVAL as a quoted string constant -- PN *)
6 FINDRGBLOCK FIXES
IN COERCE_DATUM
(*pn 27sep79...*) if RTYPE = TYPUS then
FINDRGBLOCK(S1SETREP_SIZE)
(*...pn 27sep79*) else if IS_DOUBLE[RTYPE] then FINDRP else FINDRG;
IN LOADSTACKEXCEPT
(*pn 27sep79...*) if DTYPE = TYPUS then
FINDRGBLOCK(S1SETREP_SIZE)
(*...pn 27sep79*) else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
IN VPA_FPA_FINALIND
(*pn 27sep79...*) if DTYPE = TYPUS then
FINDRGBLOCK(S1SETREP_SIZE)
(*...pn 27sep79*) else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
IN SHORT_AND_REG
(*pn 27sep79...*) if DTYPE = TYPUS then
FINDRGBLOCK(S1SETREP_SIZE)
(*...pn 27sep79*) else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
IN DEREF_TO_END
(*pn 27sep79...*) if STK[STE].DTYPE = TYPUS then
FINDRGBLOCK(S1SETREP_SIZE)
(*...pn 27sep79*) else if IS_DOUBLE[DTYPE] then FINDRP else FINDRG;
IN UDUP : (* als/peg 02jul79 *)
(*pn 27sep79...*) if TYP = TYPUS then
FINDRGBLOCK(S1SETREP_SIZE)
(*...pn 27sep79*) else if IS_DOUBLE[TYP] then FINDRP else FINDRG;
" (* older version used -- pn *)
procedure UPD_BOUNDTBL (var DISP : S1DISP; LOW, HI : integer;
(* if DTYPE in [TYPUJ,TYPUL,TYPUB,TYPUC] then *) (*pn*)
if DTYPE in [TYPUJ,TYPUL,TYPUB,TYPUC,TYPQ] then
3 SIMPLIFY FIXES
IN procedure COMPARE_SETS; (*peg 03jul79...*)
UDIF
USGS, UINN : (* als/peg 05jul79 *)
with STK[TOP] do
if (NVPAS = 1) and (VPA1.VPAIND = IND2) and (VPA1.VPA.WHICH = MEM) then
SIMPLIFY(TOP); (*pn*)
with STK[TOP-1] do
if (NVPAS = 1) and (VPA1.VPAIND = IND2) and (VPA1.VPA.WHICH = MEM) then
SIMPLIFY(TOP-1); (*pn*)
INDIRECTION FIX IN UEQU .
if (TYP <> TYPUM) then (*pn*)
for STE := TOP-1 to TOP do
with STK[STE] do
begin
INC_INDIRECTION(STE, IND1);
DTYPE := TYP;
DLENGTH := I1;
end (*with STK[STE] do*);
IN 2 PLACES
IMM_OPERAND (OPND2, I1 div CHARBITS); (* pn *)
IN ULDA :
DLENGTH := WORDUNITS; (*pn*)
IN USTR, UNSTR : (* als/peg 03jul79 *)
if TYP = TYPUE then (*pn*)
begin
TYP := TYPUJ;
I3 := 36;
end;
(* OPND.XW.DISP := -I1; *) (*pn*)
OPND1.XW.DISP := I1;
IN UEND : (* als/peg 05jul79 *)
if MAXTMPS1REG > OLDMAXTMPS1REG then (*pn*)
begin
OLDMAXTMPS1REG := MAXTMPS1REG;
MOSTCOMPLEXPROC := NAM1.NAM;
end;
(* pn: TYPUB added (index checking for ARRAY[boolean]) *)
[TYPUA, TYPUB, TYPUC, TYPUI, TYPUJ, TYPUK, TYPUL, TYPUN, TYPUS]) then
(* the following assignments to DLENGTH ARE necessary *)
else if (TYPO2 = TYPUB) then (*pn*)
begin
if BREPRES=BJUMP then BJUMP_TO_BINTVAL (TOP);
DLENGTH := QWBITS;
end
IN UDUP : (* als/peg 02jul79 *)
if TYP in [TYPUJ,TYPUL] then COERCE_INT_DATUM (TOP); (*PN*)
IN UIXA : (* als/peg 29Jun79 *)
(* if TYP in [TYPUJ, TYPUL] then *) (*pn*)
if STK[TOP].DTYPE in [TYPUJ, TYPUL] then
COERCE_INT_DATUM(TOP);
IN UPAR :
IF STK[TOP].DTYPE = TYPUM then (*pn*)
COERCE_DATUM (TOP, TYPUA);
(* S1OP := XMOV_S_S; *)
S1OP := MOV_X_X[TYP]; (* pn *)
IN UCUP, UICUP: (*peg 09aug79*)
while PARM <= PRMTOP do (*pn...*)
begin (*check reg. parms for correct order, collect excess*)
if IS_DOUBLE[STK[PARM].DTYPE] then
PARMWORDSIZE := 2
else PARMWORDSIZE := 1;
if (PWORDCOUNT + PARMWORDSIZE > MAXPAREG) then
EXCESS := EXCESS + PARMWORDSIZE
else
begin (*reg. parm*)
LASTREGPARM := PARM;
PREG := MINPARS1REG + PWORDCOUNT;
if not (DAT_IS_REG(PARM)
and (STK[PARM].VPA1.VPA.RGADR = PREG)) then
ASSERTFAIL('UCUP 001');
end (*reg. parm*);
PWORDCOUNT := PWORDCOUNT + PARMWORDSIZE;
PARM := PARM + 1;
end (*check reg. parms*); (*...pn*)
IN procedure READSET(var S : SETREP);
(*Read a set as a string of octal digits and convert it to a SETREP,
returning it in S. PDP-10 version. *)
(* pn 19SEP79 *)
var J, N : integer;
CH : char;
begin
while (INPUT↑=' ') do get (INPUT);
S := NULL_SET;
N := 0;
while N < SET_SIZE do
begin
read (INPUT, CH);
J := ORD (CH) - ORD ('0');
if J > 3 then BUILD_SET(S,N);
if (J mod 4) > 1 then BUILD_SET(S,N+1);
if odd(J) then BUILD_SET(S,N+2);
N := N + 3;
end
end (*READSET*);
IN UCOMM :
begin (* pn *)
while (CH = ' ') and not eoln(INPUT) do READ(CH);
CLEN := 0;
while not eoln(INPUT) and (CLEN < COMMLEN) do
begin
CLEN := CLEN + 1;
READ(CH); COMMFIELD[CLEN] := CH;
end;
end (*UCOMM*);
IN procedure INITIALIZE;
OLDMAXTMPS1REG := MAXTMPS1REG; (*pn*)
IN MAIN_PROGRAM: **)
WRITELN(OUTPUT); (* pn *)